00010	BEGIN "STUDY"
00020	DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
00030	DEFINE ⊃="⊂";
00040	REQUIRE "BLOCKS.HDR[4,ALS]" SOURCE_FILE;
00050	INTEGER ARRAY LFILE[0:'177];
00060	INTEGER ARRAY SYMBOL[0:127];
00070	STRING ARRAY SAMPLE[0:127];
00080	INTEGER I,J,K,L,M,N,P,PP,Q,R,POINTX,STATE,DELTA,VAL,CHAN1,EOF,DVAL,DK,DDVAL,DDK,DDDVAL,DDDK;
00090	INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,READ3,SEGTOT,SEGIN;
00100	BOOLEAN ER;
00110	INTEGER CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,CHANX;
00120	INTEGER ARRAY BUF[0:511];
00130	STRING FILEN,READ,READ1,FILEO,READ2,FILEQ,TFILE,FILLST;
00140	⊂ STATE=0 means on way up
00150	  STATE=1 means on way down;
00160	
00170	PROCEDURE OUTALL(STRING S);
00180	BEGIN
00190	STRING SS; INTEGER J;
00200	SETBREAK(18,0,NULL,"OSN");
00210	SS←SCAN(S,18,J);
00220	OUTSTR(SS);
00230	END;
00240	
00250	PROCEDURE DATAIN;
00260	BEGIN
00270	INTEGER J;
00280	  FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00290	  IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512)
00300	  ELSE OUTSTR("No more data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00310	  POINTX←POINT(12,BUF[0],-1);
00320	SEGC←II←II+12; JJ←II+11;
00330	END;
00340	
00350	PROCEDURE FRIC;
00360	BEGIN
00370	INTEGER JJJ;
00380	  M←0;
00390	  FOR JJJ←0 STEP 1 UNTIL 127 DO BEGIN
00400	    VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00405	    DVAL←VAL-K; DDVAL←DVAL-DK; DDDVAL←DDVAL-DDK;
00410	    IF STATE=0 THEN BEGIN
00420	     IF DDDVAL<DDDK-DELTA THEN BEGIN
00430	      M←M+(DDDK-DDDVAL); STATE←-1; END; END ELSE
00440	     IF DDDVAL>DDDK+DELTA THEN  BEGIN
00450	      M←M+(DDDVAL-DDDK); STATE←0; END;
00460	    K←VAL; DK←DVAL;DDK←DDVAL; DDDK←DDDVAL;
00470	    IF JJJ=3 THEN M←0;
00480	    END;
00485	M←M%400; IF M>63 THEN M←63;
00490	SEGC←SEGC+1;
00500	END;
00510	
00520	PROCEDURE SKIP;
00530	BEGIN
00540	INTEGER JJJ;
00550	 FOR JJJ←0 STEP 1 UNTIL 127 DO IBP(POINTX);
00560	K←LDB(POINTX); IF K>2047 THEN K←K-4096;
00570	SEGC←SEGC+1;
00580	⊃ OUTSTR("Skip to segc= "&CVS(SEGC)&CRLF);
00590	END;
00600	
00610	FILEN←"HI20.001[CMP,NJM]";
00620	  FILEO←"SEG1.FRI";
00630	OUTSTR("Specify DELTA (CR for 15) ");
00640	IF (READ←INCHWL)="" THEN DELTA←15 ELSE DELTA←CVD(READ);
00650	STDBRK(1);
00660	 SETBREAK(14,"∃",NULL,"INS");
00670	 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00680	 SETBREAK(16,'56,NULL,"INA");
00690	 SETBREAK(17,'12,'15,"INS");
00700	
00710	CHAN1←1; CHAN2←2; CHAN3←3;  CHAN4←4; CHAN5←5; CHAN6←6;
00720	OUTSTR("This program will list header information in man-readable form"
00730	  &CRLF&"togather with the output from procedure FLOPS"&crlf);
00740	
00750	CLOSE(CHAN4); OPEN(CHAN4,"DSK",1,2,0,3500,BRK,EOFA);
00760	LOOKUP(CHAN4,"MAP.PHN",ER);
00770	WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find MAP.PHN[NET,NJM].  File = ");
00780	LOOKUP(CHAN4,TFILE←INCHWL,ER); END;  EOFA←0;
00790	FILLST←INPUT(CHAN4,14);
00800	⊂ OUTSTR("MAP.PHN contains "&CRLF&FILLST&CRLF);
00810	CLOSE(CHAN4);
00820	
00830	FOR I←0 STEP 1 UNTIL 127 DO  BEGIN
00840	  WHILE TRUE DO BEGIN
00850	    READ1←SCAN(FILLST,17,K);
00860	    READ3←READ1[1 TO 1];
00870	    IF READ3≠"⊂"  THEN DONE; END;
00880	IF READ3="" THEN DONE;
00890	  SYMBOL[I]←CVASC(SCAN(READ1,15,K));
00900	  SAMPLE[I]←READ1; END;
00910	
00920	FOR PP←1 STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00930	  CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00940	SETFORMAT(-3,0); FILEQ←CVS(PP);
00950	  FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,NJM]";
00960	LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00970	WHILE ER DO BEGIN
00980	   OUTSTR(CRLF&"Can not find file "&TFILE&"  File= ");
00990	   LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
01000	J←K←L←STATE←VAL←R←0;
01010	SETFORMAT(1,0);  FILEQ←CVS(PP);
01020	
01030	READ←FILEO[1 TO 3]&FILEQ&".T0X";
01040	CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOFA);
01050	LOOKUP(CHAN4,READ,ER); TFILE←READ;
01060	WHILE ER DO BEGIN
01070	   OUTSTR(CRLF&"Can not find file "&TFILE&"  File= ");
01080	   LOOKUP(CHAN4,TFILE←INCHWL,ER); END;
01090	ARRYIN(CHAN4,LFILE[0],'200);	⊂ Input header;
01100	SEGTOT←(LFILE[0]*6)%256;
01110	⊃ OUTSTR(FILEI&" "&CVS(SEGTOT)&"   ");
01120	CLOSE(CHAN4);
01130	
01140	READ2←READ;
01150	READ1←SCAN(READ2,16,J)&"DOC";
01160	⊃ OUTSTR("Ready to write "&READ1&TB);
01170	OPEN(CHAN4,"DSK",0,0,10,0,0,EOFA);
01180	ENTER(CHAN4,READ1,0);
01190	OUT(CHAN4," Header information from file   "&READ&"."&TB&TB&DATIME&CRLF);
01200	OUT(CHAN4," Acoustic data from file  "&FILEN&CRLF);
01210	OUT(CHAN4,"   Produced by program STUDY and filed in  "&READ1&"."&CRLF);
01220	OUT(CHAN4,"     Frication measure computed with DELTA set at "&cvs(delta)&CRLF);
01230	OUT(CHAN4," "&CRLF&" ");
01240	  FOR I←0 STEP 1 UNTIL 9 DO OUT(CHAN4,CVS(LFILE[I])&TB);
01250	OUT(CHAN4,CRLF&" ");
01260	  FOR I←10 STEP 1 UNTIL 20 DO OUT(CHAN4,CVXSTR(LFILE[I]));
01270	  OUT(CHAN4,CRLF&LF);
01280	OUTSTR(CRLF&"  ");
01290	  FOR I←10 STEP 1 UNTIL 20 DO OUTSTR(CVXSTR(LFILE[I]));
01300	OUTSTR(CRLF&LF);
01310	OUT(CHAN4,"Frication measure"&TB&"Header information"&TB&"Explanation"&CRLF);
01320	OUT(CHAN4,"First"&TB&"Average"&TB&"Last"&TB&
01330	   "Hint"&TB&"Start"&TB&"Length"&TB&"Example"&TB&"Features"&CRLF);
01340	OUTSTR(CRLF&"First"&TB&"Average"&TB&"Last"&TB
01350	   &"Symbol"&TB&"Start"&TB&"Length"&TB&"Sample"&TB&"Features"&CRLF&LF);
01360	
01370	II←-11; JJ←-1; SETFORMAT(4,0); SEGIN←0;
01380	FOR I←21 STEP 1 UNTIL 127 DO BEGIN
01390	  IF LFILE[I]=0 THEN IF I>0 THEN DONE ELSE BEGIN OUTSTR("No data."&crlf);
01400	    done end;
01410	  L←LFILE[I] LAND '777760000000;
01420	  FOR Q←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[Q] THEN DONE;
01430	  J←LDB(POINT(14,LFILE[I],27)); KK←LDB(POINT(8,LFILE[I],35));
01440	
01450	IF KK≤0 THEN BEGIN OUT(CHAN4,TB&TB&TB); OUTSTR(TB&TB&TB); END ELSE BEGIN
01460	  IF II>J THEN BEGIN
01470	    OUTSTR("Out of step with SEGC= "&CVS(SEGC)&", J= "&CVS(J)&" and II= "&
01480	     CVS(II)&CRLF);
01490	    INCHWL; END;
01500	WHILE JJ<J DO DATAIN;
01510	WHILE SEGC<J DO SKIP;
01520	FRIC;
01530	IF M>0 THEN OUT(CHAN4,CVS(M)&TB) ELSE OUT(CHAN4,"  "&TB);
01540	IF M>0 THEN OUTSTR(CVS(M)&TB) ELSE OUTSTR("  "&TB);
01550	N←M;
01560	FOR R←2 STEP 1 UNTIL KK DO BEGIN
01570	  IF SEGC>JJ THEN DATAIN;
01580	  FRIC; N←N+M; END;
01590	N←N%KK; 
01600	IF N>0 THEN OUT(CHAN4,CVS(N)&TB) ELSE OUT(CHAN4,"  "&TB);
01610	IF M>0 THEN OUT(CHAN4,CVS(M)&TB) ELSE OUT(CHAN4,"  "&TB);
01620	IF N>0 THEN OUTSTR(CVS(N)&TB) ELSE OUTSTR("  "&TB);
01630	IF M>0 THEN OUTSTR(CVS(M)&TB) ELSE OUTSTR("  "&TB);
01640	END;
01650	
01660	  OUT(CHAN4,CVSTR(L)&TB&CVS(J)&TB&CVS(KK)&TB&SAMPLE[Q]&CRLF);
01670	  OUTALL(CVSTR(L)&TB&CVS(J)&TB&CVS(KK)&TB&SAMPLE[Q]&CRLF);
01680	  END; CLOSE(CHAN4);
01690	
01700	OUTSTR(CRLF&"File "&READ1&" has been written."&CRLF&LF);
01710	IF (STRIN("Do you want it spooled (Y or CR) "))="Y" THEN
01720	  SPOOL(READ1,GETCHAN,0);
01730	END "FILEREAD";
01740	END "STUDY";